home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / preces.asc < prev    next >
Encoding:
Text File  |  1979-12-31  |  3.1 KB  |  96 lines
  1. 1000 ' ================ PRECESS.BAS =====================
  2. 1010 '   Written for Microsoft BASIC Version 5.211
  3. 1020 '      Published in ASTRONOMY, August 1984
  4. 1030 '         By J. P. POOL and R. L. Berry
  5. 1040 '
  6. 1050 PRINT "This program computes rigorous precession"
  7. 1060 PRINT "from a string representation of RA and DEC"
  8. 1070 PRINT "and returns a string representation of the"
  9. 1080 PRINT "precessed coordinates."
  10. 1090 '
  11. 1100 R=.01745329#
  12. 1110 '
  13. 1120 ' ====== compute the constants of precession ======
  14. 1130 '
  15. 1140 INPUT "INITIAL EPOCH";IN
  16. 1150 INPUT "  FINAL EPOCH";FI
  17. 1160 T1=FI-IN
  18. 1170 T=T1/100
  19. 1180 Z0=((2305.65*T)+(.302*T*T)+(.018*T*T*T))
  20. 1190 Z1=R*(Z0/3600)
  21. 1200 Z=(Z0+(.791*T*T))/3600
  22. 1210 TH=R*(((2003.829#*T)-(.426*T*T)-(.042*T*T*T))/3600)
  23. 1220 '
  24. 1230 ' ==== input coordinates and proper motion ====
  25. 1240 '
  26. 1250 PRINT "INITIAL RA: HH MM SS.F"
  27. 1260 INPUT"          ";RA$
  28. 1270 PRINT "INITIAL DC: +DD MM SS"
  29. 1280 INPUT"          ";DEC$
  30. 1290 INPUT "PROPER MOTION: <MUra,MUdec>";MURA,MUDC
  31. 1300 MURA=T1*15*MURA/3600:MUDC=T1*MUDC/3600
  32. 1310 IRA=VAL(MID$(RA$,1,2))
  33. 1320 IRA=IRA+VAL(MID$(RA$,4,2))/60
  34. 1330 IRA=IRA+VAL(MID$(RA$,7,4))/3600
  35. 1340 IRA=15*IRA
  36. 1350 IDC=VAL(MID$(DEC$,2,2))
  37. 1360 IDC=IDC+VAL(MID$(DEC$,5,2))/60
  38. 1370 IDC=IDC+VAL(MID$(DEC$,8,2))/3600
  39. 1380 IF MID$(DEC$,1,1)="-" THEN IDC=-IDC
  40. 1390 AL0=R*(IRA+MURA)
  41. 1400 DL0=R*(IDC+MUDC)
  42. 1410 '
  43. 1420 ' ======== precess the coordinates ===============
  44. 1430 '
  45. 1440 A=COS(DL0)*SIN(AL0+Z1)
  46. 1450 B=(COS(TH)*COS(DL0)*COS(AL0+Z1))-(SIN(TH)*SIN(DL0))
  47. 1460 C=(SIN(TH)*COS(DL0)*COS(AL0+Z1))+(COS(TH)*SIN(DL0))
  48. 1470 ALPMZ= ATN(A/B)/R
  49. 1480 AL=(ALPMZ+Z)/15
  50. 1490 IF B<0 AND A>0 THEN AL=AL+12
  51. 1500 IF B<0 AND A<0 THEN AL=AL+12
  52. 1510 IF B>0 AND A<0 THEN AL=AL+24
  53. 1520 DL=ATN(C/SQR(1-C*C))/R
  54. 1530 '
  55. 1540 ' ==== convert decimal RA to HH MM SS.F string ====
  56. 1550 '
  57. 1560 RAH=FIX(AL)
  58. 1570 RAM=INT(60*(AL-RAH))
  59. 1580 RAS=INT(3600*(AL-RAH-(RAM/60)))
  60. 1590 RAF=INT(36000!*(AL-RAH-(RAM/60)-(RAS/3600)))
  61. 1600 RAH$=STR$(RAH):RAM$=STR$(RAM)
  62. 1610 RAS$=STR$(RAS):RAF$=STR$(RAF)
  63. 1620 IF RAH<10 THEN MID$(RAH$,1)="0"
  64. 1630 IF LEN(RAH$)=3 THEN RAH$=MID$(RAH$,2,2)
  65. 1640 IF RAM<10 THEN MID$(RAM$,1)="0"
  66. 1650 IF LEN(RAM$)=2 THEN RAM$=" "+RAM$
  67. 1660 IF RAS<10 THEN MID$(RAS$,1)="0"
  68. 1670 IF LEN(RAS$)=2 THEN RAS$=" "+RAS$
  69. 1680 PRA$=RAH$+RAM$+RAS$+RAF$
  70. 1690 MID$(PRA$,9)="."
  71. 1700 '
  72. 1710 ' ==== convert decimal DEC to DD MM SS string ====
  73. 1720 '
  74. 1730 IF DL<0 THEN SG$="-" ELSE SG$="+"
  75. 1740 DL=ABS(DL)
  76. 1750 DD=FIX(DL)
  77. 1760 DM=INT(60*(DL-DD))
  78. 1770 DS=INT(3600*(DL-DD-(DM/60)))
  79. 1780 DD$=STR$(DD):DM$=STR$(DM):DS$=STR$(DS)
  80. 1790 IF DD<10 THEN MID$(DD$,1)="0"
  81. 1800 IF LEN(DD$)=3 THEN DD$=MID$(DD$,2,2)
  82. 1810 IF DM<10 THEN MID$(DM$,1)="0"
  83. 1820 IF LEN(DM$)=2 THEN DM$=" "+DM$
  84. 1830 IF DS<10 THEN MID$(DS$,1)="0"
  85. 1840 IF LEN(DS$)=2 THEN DS$=" "+DS$
  86. 1850 PDC$=SG$+DD$+DM$+DS$
  87. 1860 '
  88. 1870 ' ==== print epochs and coordinate strings ====
  89. 1880 '
  90. 1890 PRINT "Epoch";IN;RA$+"  "+DEC$
  91. 1900 PRINT "Epoch";FI;PRA$+"  "PDC$
  92. 1910 PRINT
  93. 1920 INPUT "Another? <S>ame or <N>ew epoch";ANS$
  94. 1930 IF ANS$="S" OR ANS$="s" THEN GOTO 1230
  95. 1940 IF ANS$="N" OR ANS$="n" THEN GOTO 1140
  96.